REM *****************************************

REM *******  2DFFT 13.01 - 2D XFORM   *******

REM *****************************************

10 SCREEN 9, 1, 1

12 COLOR 15, 1

14 INPUT "SELECT ARRAY SIZE AS 2^N.  N ="; N

16 Q = 2 ^ N

18 ' $DYNAMIC

20 DIM C(2, Q, Q), S(2, Q, Q), KC(Q), KS(Q), DA1(Q, Q)

22 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8: ANP = 0

24 PI = 3.141592653589793#: PI2 = 2 * PI: K1 = PI2 / Q: CLVK = 1

26 FOR I = 0 TO Q: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I): NEXT

28 CLS : PRINT : PRINT : PRINT "               MAIN MENU": PRINT

30 PRINT " 1 = GENERATE FUNCTIONS": PRINT

32 PRINT " 2 = TRANSFORM FUNCTION": PRINT

34 PRINT " 3 = INVERSE TRANSFORM ": PRINT

36 PRINT " 4 = EXIT              ": PRINT : PRINT

38 PRINT "            MAKE SELECTION";

40 A$ = INKEY$: IF A$ = "" THEN 40

42 A = VAL(A$): ON A GOSUB 5000, 50, 80, 9999, 120

GOTO 28



REM **********************************************

REM *              XFORM FUNCTION                *

REM **********************************************

50 CLS ' CLEAR SCREEN

52 FOR I = 0 TO Q - 1: FOR J = 0 TO Q - 1: C(T0, I, J) = 0: S(T0, I, J) = 0: NEXT J: NEXT I

54 K6 = -1: SK1 = 2: XDIR = 1: T9 = TIMER

56 GOSUB 200 ' DO FORWARD 2-D XFORM

58 T9 = TIMER - T9 ' CHECK TIME

60 GOSUB 160 ' DISPLAY DATA

62 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

64 RETURN



REM **********************************************

REM *            INVERSE TRANSFORM               *

REM **********************************************

80 CLS : K6 = 1: SK1 = 1: XDIR = 0: T9 = TIMER

82 GOSUB 200: REM RECONSTRUCT 2-D XFORM

84 T9 = TIMER - T9 ' GET TIME

86 GOSUB 160 ' PLOT OUTPUT

88 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

90 RETURN



REM ********************************************************

REM *               PRINT OUTPUT

REM ********************************************************

100 CLS : PRINT "ONLY THE Q/2 ROW WILL BE PRINTED"

102 PRINT "SPACIAL OR FREQUENCY? (S/F)"

104 A$ = INKEY$: IF A$ = "" THEN 104

106 ROLOC = 0 ' ROW LOCATION

108 IF A$ = "S" THEN ROLOC = Q2

110 PRINT "SCREEN OR PRINTER (S/P)"

112 A$ = INKEY$: IF A$ = "" THEN 112

114 IF A$ = "S" THEN 136

116 IF A$ <> "P" THEN 100

118 FOR I = 0 TO Q - 1

120 Y2 = C(T1, ROLOC, I): X2 = S(T1, ROLOC, I)

122 Y3 = C(T1, ROLOC + 1, I): X3 = S(T1, ROLOC + 1, I)

124 LPRINT I;

126 LPRINT USING "###.######_      "; Y2; X2; Y3; X3

128 NEXT I

132 LPRINT CHR$(12)

134 RETURN

' **************************************************

136 CLS ' PRINT SCREEN

138 FOR I = 0 TO Q - 1

140 Y2 = C(T1, ROLOC, I): X2 = S(T1, ROLOC, I)

142 Y3 = C(T1, ROLOC + 1, I): X3 = S(T1, ROLOC + 1, I)

144 IF Y2 = 0 THEN PRINT 0, 0: GOTO 152

146 PRINT I;

REM PRINT USING "###.######_      "; SQR(Y2 ^ 2 + X2 ^ 2); 180 / PI * ATN(X2 / Y2)

148 PRINT USING "###.######_      "; Y2; X2; Y3; X3

150 LINCTR = LINCTR + 1: IF LINCTR > 22 THEN GOSUB 154

152 NEXT I

154 INPUT A$

156 LINCTR = 0

158 RETURN



REM **********************************************

REM *                PLOT DATA                   *

REM **********************************************

160 CLS : AMP1 = 0 ' FIND LARGEST MAGNITUDE IN ARRAY

168     FOR I = 0 TO Q - 1

170         FOR J = 0 TO Q - 1

172              IF XDIR = 0 THEN AMP = C(T1, I, J): GOTO 176

174              AMP = SQR(C(T1, I, J) ^ 2 + S(T1, I, J) ^ 2)

176              IF AMP1 < AMP THEN AMP1 = AMP

178         NEXT J

180     NEXT I

182 IF AMP1 = 0 THEN AMP1 = 1

184 IF XDIR = 1 THEN MAG2 = -130 / AMP1 ELSE MAG2 = -6 / AMP1' SET SCALE FACTOR

186 PRINT "IS THIS A PICTURE (Y/N)";

188 A$ = INKEY$: IF A$ = "" THEN 188

190 IF A$ <> "Y" AND A$ <> "y" AND A$ <> "N" AND A$ <> "n" THEN 194

192 IF A$ = "Y" OR A$ = "y" THEN MAG2 = -6 / AMP1 ELSE MAG2 = -130 / AMP1

194 GOSUB 6000 ' PLOT 2-D DATA

196 LOCATE 1, 1: PRINT "TIME = "; T9

198 RETURN



REM ************************************************

REM *              TRANSFORM                       *

REM ************************************************

200 CLS : KRTST = 19

202 T00 = T0: T11 = T1 ' SAVE INITIAL INPUT SIDE

204 FOR KR = 0 TO Q - 1 ' XFORM 2D ARRAY BY ROWS

206 T0 = T00: T1 = T11 ' INITIALIZE INPUT SIDE OF ARRAYS

REM 207 IF XDIR = 1 THEN GOSUB 300

208 PRINT USING "###_ "; KR; ' PRINT ROW BEING XFORMED

210 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20 ' END PRINT LINE

212 REM THE ROUTINE BELOW IS THE STANDARD FFT ROUTINE FOR A ROW

214 FOR M = 0 TO N - 1: QT = 2 ^ M: KT1 = 2 ^ (N - M - 1)

216 FOR J = 0 TO Q3 STEP QT: J1 = 2 * J: K9 = J + Q2

218 FOR I = 0 TO QT - 1: KT = I * KT1: K = K9 + I

220 IF XDIR = 1 THEN GOSUB 280 ELSE GOSUB 290

222 NEXT I

224 J1 = J1 + QT

226 FOR I = 0 TO QT - 1: KT = (I + QT) * KT1: K = K9 + I

228 IF XDIR = 1 THEN GOSUB 280 ELSE GOSUB 290

230 NEXT I: NEXT J

232 T0 = 1 - T0: T1 = 1 - T1

234 NEXT M

REM 235 IF XDIR = 0 THEN GOSUB 330

236 NEXT KR

240 PRINT

REM  GOSUB 160 ' USE TO SHOW RESULTS OF ROW XFORMS

REM  241 A$ = INKEY$: IF A$ = "" THEN 241

242 KRTST = 19

243 T11 = T1: T00 = T0

244 FOR KR = 0 TO Q - 1 ' XFORM 2D ARRAY BY COLUMNS

246 T0 = T00: T1 = T11

REM 247 IF XDIR = 1 THEN GOSUB 330

248 PRINT USING "###_ "; KR;

250 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20

252 FOR M = 0 TO N - 1: QT = 2 ^ M: KT1 = 2 ^ (N - M - 1)

254 FOR J = 0 TO Q3 STEP QT: J1 = 2 * J: K9 = J + Q2

256 FOR I = 0 TO QT - 1: KT = I * KT1: K = K9 + I

258 IF XDIR = 1 THEN GOSUB 290 ELSE GOSUB 280

260 NEXT I

262 J1 = J1 + QT

264 FOR I = 0 TO QT - 1: KT = (I + QT) * KT1: K = K9 + I

266 IF XDIR = 1 THEN GOSUB 290 ELSE GOSUB 280

268 NEXT I: NEXT J

270 T0 = 1 - T0: T1 = 1 - T1

272 NEXT M:

REM 273 IF XDIR = 0 THEN GOSUB 300

274 NEXT KR

276 RETURN



REM THE SUBROUTINES BELOW ARE THE UNIVERSAL BUTTERFLY FUNCTIONS

280 C(T0, KR, J1 + I) = (C(T1, KR, I + J) + C(T1, KR, K) * KC(KT) - K6 * S(T1, KR, K) * KS(KT)) / SK1

282 S(T0, KR, J1 + I) = (S(T1, KR, I + J) + K6 * C(T1, KR, K) * KS(KT) + S(T1, KR, K) * KC(KT)) / SK1

284 RETURN

290 C(T0, J1 + I, KR) = (C(T1, I + J, KR) + C(T1, K, KR) * KC(KT) - K6 * S(T1, K, KR) * KS(KT)) / SK1

292 S(T0, J1 + I, KR) = (S(T1, I + J, KR) + K6 * C(T1, K, KR) * KS(KT) + S(T1, K, KR) * KC(KT)) / SK1

294 RETURN



' ****************************************

' *          MODIFY SAMPLING             *

' ****************************************

300 FOR I = 1 TO Q - 1 STEP 2

302 C(T1, KR, I) = -C(T1, KR, I): S(T1, KR, I) = -S(T1, KR, I)

304 NEXT I

306 RETURN



330 FOR I = 0 TO Q - 1 STEP 2

332 C(T1, I, KR) = -C(T1, I, KR): S(T1, I, KR) = -S(T1, I, KR)

334 NEXT I

336 RETURN



     REM *********************************

     REM *      GENERATE FUNCTIONS       *

     REM *********************************

5000 CLS : PRINT : PRINT : PRINT "               FUNCTION MENU": PRINT

5002 PRINT " 1 = GENERATE SINC^2 FUNCTION      2 = GENERATE STAR": PRINT

5004 PRINT " 3 = DOUBLE STAR                   4 = CIRC FUNCTION": PRINT

5008 PRINT " 5 = BESSEL                        6 = BESSEL II": PRINT

5009 PRINT " 8 = EXIT:": PRINT

5010 PRINT "            MAKE SELECTION";

5012 A$ = INKEY$: IF A$ = "" THEN 5012

5014 A = VAL(A$): ON A GOTO 5030, 5100, 5200, 5300, 5600, 5800

5016 IF A = 8 THEN RETURN

5018 GOTO 5000



     REM *********************************

     REM *       SINC^2 FUNCTION         *

     REM *********************************

5030 CLS : MAG1 = Q: T1 = 0: T0 = 1

5032 INPUT "WIDTH"; WDTH1 ' INPUT FINCTION SIZE

5034 IF WDTH1 = 0 THEN WDTH1 = 1 ' ZERO INVALID

5036 SKL1 = PI2 / WDTH1: MAG1 = Q ' CALC CONSTANTS

5038 FOR I = 0 TO Q - 1 '

5040 YARG = SKL1 * (I - Q2): PRINT "*";

5042 FOR J = 0 TO Q - 1

5044 XARG = SKL1 * (J - Q2)

5046 IF YARG = 0 AND XARG = 0 THEN C(T1, I, J) = MAG1: GOTO 5052

5048 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5050 C(T1, I, J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(0, I, J) = 0

5052 NEXT J

5054 NEXT I

5056 GOSUB 160 ' PLOT FUNCTION

5058 INPUT A$ ' WAIT

5060 RETURN



5100 REM ********************************

     REM *           STAR               *

     REM ********************************

CLS

REM INPUT "INPUT SEPARATION"; SEPR

MAG1 = Q: T1 = 0: T0 = 1

FOR I = 0 TO Q - 1 ' FIRST, CLEAR DATA

FOR J = 0 TO Q - 1

C(T1, I, J) = AN: S(T1, I, J) = 0

NEXT J

NEXT I

C(T1, Q2, Q2) = MAG1

MAG2 = -140 / Q

GOSUB 160

INPUT "C/R TO CONTINUE"; A$

RETURN



REM ***********************************

5200 REM *        DOUBLE STAR         *

REM ***********************************

CLS : T1 = 0: T0 = 1

INPUT "SEPARATION"; SEPR1

SEPR = SEPR1 / 2: MAG1 = Q

FOR I = 0 TO Q - 1 ' FIRST, CLEAR DATA

FOR J = 0 TO Q - 1

C(T1, I, J) = AN: S(T1, I, J) = 0

NEXT J

NEXT I

C(T1, Q2, Q2 - SEPR) = MAG1

C(T1, Q2, Q2 + SEPR) = MAG1



GOSUB 160

INPUT A$

RETURN



5300 REM *********************************

     REM *         CIRC FUNCTION         *

     REM *********************************

CLS : MAG1 = Q: T1 = 0: T0 = 1

INPUT "DIAMETER"; DIA1

INPUT "CENTERED ON (X,Y)"; CNTRX, CNTRY

SKL1 = Q / DIA1: MAG1 = Q

FOR I = 0 TO Q - 1

YARG = I - CNTRY: PRINT "*";

FOR J = 0 TO Q - 1

XARG = J - CNTRX

C(T1, I, J) = 0

ARG = SQR(XARG ^ 2 + YARG ^ 2)

IF ARG <= DIA1 THEN C(T1, I, J) = MAG1: S(T1, I, J) = 0

5310 NEXT J

NEXT I

GOSUB 160

INPUT A$

RETURN





     REM *********************************

     REM *       BESSEL FUNCTION         *

     REM *********************************

5600 CLS : DEFDBL D-K

5602 T0 = 1: T1 = 0

5604 INPUT "WIDTH"; WDTH1

5606 IF WDTH1 < 1 THEN 5604 ' MINIMUM WIDTH

5608 SKL1 = PI / (3.6 * WDTH1 * Q / 64)

5610 FOR I = 0 TO Q - 1

5612 YARG = SKL1 * (I - Q2): PRINT "*";

5614 FOR J = 0 TO Q - 1

5616 XARG = SKL1 * (J - Q2)

5618 KARG = SQR(XARG ^ 2 + YARG ^ 2)

5620 KA = 1: KB = 1: DAT1 = 1: KTGL = 1

5622 FOR K = 2 TO 900 STEP 2

5624 KTGL = -1 * KTGL

5626 KA = KA * K: KB = KB * (K + 2): DENOM = KA * KB

5628 DAT2 = KTGL * (WDTH1 ^ (K / 2) * KARG ^ K / DENOM)

5630 IF ABS(DAT2) < ABS(DAT1) * 1E-10 THEN 5640

5632 DAT1 = DAT1 + DAT2

5634 REM PRINT DAT1,

5636 NEXT K

5638 PRINT "#"

5640 C(T1, I, J) = DAT1: S(T1, I, J) = 0

5642 NEXT J

5644 NEXT I

5646 GOSUB 160

5648 INPUT A$

5650 RETURN



     REM *********************************

     REM *     BESSEL FUNCTION II        *

     REM *********************************

5800 CLS

5802 MAG1 = Q: T1 = 0: T0 = 1: M3 = 1: KR = PI2 / Q

5804 FOR I = 0 TO Q: FOR J = 0 TO Q: C(T1, I, J) = 0: S(T1, I, J) = 0: NEXT: NEXT

5806 INPUT "WIDTH"; WDH

5808 FOR A = 0 TO WDH: IF A = 0 THEN M2 = M3 / 2 ELSE M2 = M3

5810 FOR B = 0 TO SQR(WDH ^ 2 - A ^ 2): IF B = 0 THEN M1 = M2 / 2 ELSE M1 = M2

5812 FOR I = 0 TO Q - 1: I2 = A * (I - Q2)

5814 FOR J = 0 TO Q - 1: J2 = B * (J - Q2)

5816 C(T1, I, J) = C(T1, I, J) + M1 * (COS(KR * (I2 - J2)) + COS(KR * (I2 + J2)))

5818 NEXT J

5820 NEXT I

5822 PRINT "*";

5824 NEXT B

5826 NEXT A

5828 GOSUB 160

5830 INPUT A$

5832 RETURN



6000 REM *******************************

     REM *         PLOT DATA           *

     REM *******************************

CLS ' CLEAR SCREEN AND SET SCALE FACTORS

XCAL = 320 / Q: YCAL = 120 / Q: YDIS = 150

FOR I = 0 TO Q - 1 ' FOR ALL ROWS

DISP = (Q - I) * 288 / Q ' DISPLACE ROWS FOR 3/4 VIEW

PER = I / (2 * Q) ' CORRECT FOR PERSPECTIVE

FOR J = 0 TO Q - 1 ' FOR EACH PIXEL IN ROW

X11 = ((XCAL + PER) * J) + DISP: Y11 = ((YCAL + .3 * PER) * I) + YDIS

IF XDIR = 0 THEN AMP = C(T1, I, J) ELSE AMP = SQR(C(T1, I, J) ^ 2 + S(T1, I, J) ^ 2)' CALC "Z" AXIS

AMP = MAG2 * AMP

LINE (X11, Y11 + AMP)-(X11, Y11)

NEXT J ' NEXT PIXEL

NEXT I ' NEXT ROW

RETURN ' ALL DONE





9999 END: STOP



